home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / adaMode.tcl next >
Text File  |  1996-08-15  |  3KB  |  103 lines
  1.  
  2. if {$startingUp} {
  3.  
  4.     addMode Ada dummyAda {*.ada *.ads *.adb *.ADS *.ADB *_.a *.a } {}
  5.  
  6.     return
  7. }
  8.  
  9. #===============================================================================
  10. # From Raymond Waldrop <rwaldrop@cs.tamu.edu>
  11. #===============================================================================
  12.  
  13. newModeVar Ada elecRBrace {1} 1
  14. newModeVar Ada leftFillColumn {3} 0
  15. newModeVar Ada prefixString {-- } 0 
  16. newModeVar Ada electricSemi {1} 1
  17. newModeVar Ada wordBreak {[a-zA-Z0-9_]+} 0
  18. newModeVar Ada elecLBrace {1} 1
  19. newModeVar Ada wordWrap {0} 1
  20. newModeVar Ada funcExpr {^[ \t]*(procedure|function)[ \t]+([A-Za-z][A-Za-z0-9_]*)} 0
  21. newModeVar Ada wordBreakPreface {[^a-zA-Z0-9_]} 0
  22. newModeVar Ada electricTab {0} 1
  23.  
  24. # Don't get used!
  25. #set adaCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  26. #set adaPreRegexp        {^\#[\t ]*[a-z]*}
  27. set adaKeyWords        {
  28.     abort abs accept access all and array at begin body case constant
  29.     declare delay delta digits do else elsif end entry exception exit
  30.     for function generic goto others if in is limited loop mod new not
  31.     null of or subtype out package pragma private procedure raise range
  32.     record rem renames return reverse select separate task terminate
  33.     then type use when while with xor = /=  := > < abstract aliased 
  34.     protected requeue tagged until
  35.     }
  36. regModeKeywords -e {--} -c magenta -k blue Ada $adaKeyWords -i ")" -i "(" -i ":" -i ";" -i "," -i "." -I blue
  37.  
  38. proc dummyAda {} {}
  39.  
  40. #===============================================================================
  41. # From Tom Konantz
  42. #===============================================================================
  43.  
  44. proc AdaMarkFile {} {
  45.     global AdamodeVars
  46.     set pos 0
  47.     
  48.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $AdamodeVars(funcExpr) $pos} res]} {
  49.         set start [lindex $res 0]
  50.         set end [expr [lindex $res 1] + 1]
  51.         set text [getText $start $end]
  52.                 
  53.         if {[regexp    -nocase    -indices {(procedure|function)[    \t]+([a-zA-Z0-9_]+)} $text dummy dummy0    pname]}    {
  54.             set    i1 [expr [lindex $pname    0]    + $start]
  55.             set    i2    [expr [lindex $pname 1]    + $start + 1]
  56.             set    word  [getText $i1 $i2]
  57.             set    tmp    [concat    $i1    $i2]
  58.             
  59.             if {[info exists cnts($word)]} {
  60.                 # This section handles duplicate. i.e., overloaded names
  61.                 set cnts($word) [expr $cnts($word) + 1]
  62.                 set ol_word [ join [concat $word "#" $cnts($word)] ""]
  63.                 set inds($ol_word) $tmp
  64.             } else {
  65.                 set cnts($word) 1
  66.                 set inds($word) $tmp
  67.             }
  68.         }
  69.  
  70.     
  71.         set pos $end
  72.     }
  73.     if {[info exists inds]} {
  74.       foreach f [lsort -ignore [array names inds]] {
  75.             set res $inds($f)
  76.             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  77.         }
  78.     }
  79. }
  80.  
  81. # the following will switch between the Ada spec & body,
  82. # assuming they're in the same directory
  83. # and use either GNAT or VAX Ada naming conventions.
  84. # other conventions can be supported fairly easily.
  85. proc otherPart {} {
  86.     global winActive
  87.     set curname [lindex $winActive 0]
  88.     if {[regsub  "(.*)\.ads" $curname {\1.adb} tgtname]}  {
  89.         openFileQuietly $tgtname
  90.     } elseif  {[regsub  "(.*)\.adb" $curname {\1.ads} tgtname]}  {
  91.         openFileQuietly $tgtname
  92.     # Next clause must precede the one after it!
  93.     } elseif  {[regsub  {(.*)_\.a$} $curname {\1.a} tgtname]}  {
  94.         openFileQuietly $tgtname
  95.     } elseif  {[regsub  {(.*)\.a$} $curname {\1_.a} tgtname]}  {
  96.         openFileQuietly $tgtname
  97.     } else {
  98.          error "NoMatch"
  99.     }
  100. }
  101.  
  102. bind f9 otherPart Ada
  103.